#lang errortrace racket
(require rackunit)

(define x (make-parameter 1))
(define buff (open-output-string))
(parameterize ([current-output-port buff] [x 10])
  ; In this context, the standard output is a string buffer.
  (display (format "hello ~a!" (x))))
(check-equal? (get-output-string buff) "hello 10!")
;(display "foo\n")

;[x y]

;(define (f x ret))
;  (ret (+ x 2)))

;(f 10 (lambda (x) x))

;






(define (safe-/ x y)
  (lambda (ok err)
    (cond [(= 0 y) (err 'division-by-zero)]
          [else (ok (/ x y))])))

(define (default-ok x)
  (cons 'ok x))
(define (default-fail x)
  (cons 'error x))
;((safe-/ 2 1) (lambda (x) (cons 'ok x)) error)
;((safe-/ 2 0) default-ok (lambda (x) (cons 'error x)))

; (/ (/ 10 2) 3)

(define o1 (safe-/ 10 2))

(define o2 (lambda (x) (safe-/ x 3)))


;(o1 (lambda (x) ((o2 x) default-ok default-fail)) default-fail)


; ------------------------------------------------------------------------------


(define (pure x)
  (lambda (ret err)
    (ret x)))
(define (raise x)
  (lambda (ret err)
    (err x)))
(define (cps-bind o1 o2)
  (lambda (ret err)
    (o1 (lambda (res) ((o2 res) ret err)) err)))
(define (try o1 o2)
  (lambda (ret err)
    (o1 ret (lambda (res) ((o2 res) ret err)))))
(struct return-ok (value) #:transparent)
(struct return-error (value) #:transparent)
(define (run-cps op)
  (op return-ok return-error))


(define (&/ x y)
  (cond [(= 0 y) (raise 'division-by-zero)]
        [else (pure (/ x y))]))

;(define o1 (safe-/ 10 2))
;(define o2 (lambda (x) (safe-/ x 3)))

#|
((cps-bind (&/ 10 2)
  (lambda (x)
    (&/ x 3))) default-ok default-fail)
|#
#|
(run-cps
  (cps-bind (&/ 10 2)
    (lambda (x)
      (&/ x 3))))
|#

(define-syntax do
  (syntax-rules (<-)
    ; Only one monadic-op, return it
    [(_ mexp) mexp]
    ; A binding operation
    [(_ var <- mexp rest ...) (cps-bind mexp (lambda (var) (do rest ...)))]
    ; No binding operator, just ignore the return value
    [(_ mexp rest ...)        (cps-bind mexp (lambda (_) (do rest ...)))]))

(define-check (run? op expected)
  (check-equal? (run-cps op) expected))
#|
(run? (&/ 1 0) (cons 'error 'division-by-zero))


(run?
  (try
    (&/ 1 0)
    (lambda (err) (pure 10)))
  (cons 'ok 10))



(run?
  (do
    x <- (&/ 3 4)
    (try
      (&/ x 0)
      (lambda (err) (pure 10))))
  (cons 'ok 10))
|#
#|
(run?
  (cps-bind (&/ 3 4)
    (lambda (x)
      (try
        (&/ x 0
          (lambda (err) (pure 10))))))
  (cons 'ok 10))
|#




; A suspended compuation holds two things
; - value: the value being yielded
; - ok: the ok-continuation that we must use to resume
(struct susp (value ok) #:transparent)

; A yield does not use `ok` nor `err` to return its result
; Instead, it just returns a special value called `susp`
(define (yield v)
  (lambda (ok err)
    (susp v ok)))

; Resume simply calls the continuation and passes void to it
;
; Imagine you have some code:
;    y <- (yield x) ; y is always void
;    ... ; k
;
; Resume takes the continuation (lambda (y) k) and passes void to it.
(define (resume s)
  ((susp-ok s) (void)))

; Now that we have resume, what we can do with it is as follows:
;
; For each value yield point `x` in computation `m`, call `(f x)`.
; for-each is a cps-operation that returns whatever `m` returns
(define (for-each m f)
  (lambda (ok err)
    (define (each res)
      (cond
        [(susp? res)
          ; We found a: (yield x)
          ; Call f on the suspended value
          ; (f x)
          (f (susp-value res))
          ; Continue running the suspended task with `resume`
          (each (resume res))]
        [else (ok res)]))
    (each (m (lambda (x) x) err))))

#|
  Buid a list with all the yield points of `m` and return that list.
|#
(define (to-list m)
  (lambda (ok err)
    (define (each res accum)
      (cond
        [(susp? res)
          (each
            ; Continue running the suspended task
            (resume res)
            ; We continue building our accumulated valeus
            (cons (susp-value res) accum))]
        [else (ok (reverse accum))]))
      (each (m (lambda (x) x) err) empty)))


(define three-values
  (do
    (yield 1)
    (yield 2)
    (yield 3)
    (yield 10)
    (pure "hello world!")))
#|
(run-cps
  (for-each three-values
    (lambda (x) (printf "Got element: ~a\n" x))))
|#
(run-cps
  (do
    l <- (to-list three-values)
    (pure (printf "-> Got a list: ~a\n" l))
    (pure (cons 0 l))))
